home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbtool.arc / CHAPTER1.PAS next >
Encoding:
Pascal/Delphi Source File  |  1985-04-01  |  2.3 KB  |  145 lines
  1. {$A-}
  2. program chapter1;
  3. {$I TOOLU.PAS}
  4. var cmdptr:file;
  5.  
  6. PROCEDURE COPY;
  7. VAR C:CHARACTER;
  8. BEGIN
  9.   WHILE(GETC(C)<>ENDFILE)DO
  10.     PUTC(C)
  11. END;
  12.  
  13.  
  14. PROCEDURE CHARCOUNT;
  15. VAR
  16.   NC:INTEGER;
  17.   C:CHARACTER;
  18. BEGIN
  19.   NC:=0;
  20.   WHILE (GETC(C)<>ENDFILE)DO
  21.      NC:=NC+1;
  22.   PUTDEC(NC,1);
  23.   PUTC(NEWLINE)
  24. END;
  25.  
  26. PROCEDURE LINECOUNT;
  27. VAR
  28.   N1:INTEGER;
  29.   C:CHARACTER;
  30. BEGIN
  31.   N1:=0;
  32.   WHILE(GETC(C)<>ENDFILE)DO
  33.     IF(C=NEWLINE)THEN
  34.       N1:=N1+1;
  35.   PUTDEC(N1,1);
  36.   PUTC(NEWLINE)
  37. END;
  38.  
  39. PROCEDURE WORDCOUNT;
  40. VAR
  41.   NW:INTEGER;
  42.   C:CHARACTER;
  43.   INWORD:BOOLEAN;
  44. BEGIN
  45.   NW:=0;
  46.   INWORD:=FALSE;
  47.   WHILE(GETC(C)<>ENDFILE)DO
  48.     IF(C=BLANK)OR(C=NEWLINE)OR(C=TAB) THEN
  49.       INWORD:=FALSE
  50.     ELSE IF (NOT INWORD)THEN BEGIN
  51.       INWORD:=TRUE;
  52.       NW:=NW+1
  53.     END;
  54.   PUTDEC(NW,1);
  55.   PUTC(NEWLINE)
  56. END;
  57.  
  58. PROCEDURE DETAB;
  59. CONST
  60.   MAXLINE=1000;
  61. TYPE
  62.   TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
  63. VAR
  64.   C:CHARACTER;
  65.   COL:INTEGER;
  66.   TABSTOPS:TABTYPE;
  67.  
  68. FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE)
  69.   :BOOLEAN;
  70. BEGIN
  71.   IF(COL>MAXLINE)THEN
  72.     TABPOS:=TRUE
  73.   ELSE
  74.     TABPOS:=TABSTOPS[COL]
  75. END;
  76.  
  77. PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
  78. CONST
  79.   TABSPACE=4;
  80. VAR
  81.   I:INTEGER;
  82. BEGIN
  83.   FOR I:=1 TO MAXLINE DO
  84.     TABSTOPS[I]:=(I MOD TABSPACE = 1)
  85. END;
  86.  
  87. BEGIN
  88.   SETTABS(TABSTOPS);
  89.   COL:=1;
  90.   WHILE(GETC(C)<>ENDFILE)DO
  91.     IF(C=TAB)THEN
  92.      REPEAT
  93.       PUTC(BLANK);
  94.       COL:=COL+1
  95.      UNTIL(TABPOS(COL,TABSTOPS))
  96.     ELSE IF(C=NEWLINE)THEN BEGIN
  97.       PUTC(NEWLINE);
  98.       COL:=1
  99.     END
  100.     ELSE BEGIN
  101.       PUTC(C);
  102.       COL:=COL+1
  103.     END
  104. END;
  105.  
  106.   
  107. PROCEDURE COMMAND;
  108. VAR I:INTEGER;XS:XSTRING;B:BOOLEAN;
  109. S:PACKED ARRAY[1..3]OF CHAR;
  110.  
  111. BEGIN
  112.   B:=GETARG(1,XS,MAXSTR);
  113.   IF (B=TRUE)THEN BEGIN
  114.     for i:=1 to 3 do begin
  115.       s[i]:=chr(xs[i]);
  116.       if s[i]in['a'..'z']then s[i]:=chr(xs[i]-32)
  117.     end;
  118.   END
  119.   ELSE ERROR('Command:no arguments');
  120.  
  121.   IF (S='COP') THEN COPY
  122.   ELSE IF (S='CHA') THEN CHARCOUNT
  123. ELSE IF (S=
  124.   'LIN') THEN LINECOUNT
  125. ELSE IF (S=
  126.   'WOR') THEN WORDCOUNT
  127. ELSE IF (S=
  128.   'DET') THEN DETAB
  129. END;(*COMMAND*)
  130.  
  131.  
  132.  
  133.  
  134.  
  135. BEGIN
  136.     command;
  137.     ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr)
  138. END.
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.